STAT 184 - Final Project

Front Matter

# clean up workspace environment
rm(list = ls())
# all packages used for the assignment
library(mosaicData)
library(DataComputing)
library(dplyr)
library(tidyverse)
library(ggplot2)
library(lubridate)

Guiding Question: Is there any correlation between number of likes, dislikes and comments on YouTube Videos? (Can we find any relationship between number of views, likes, dislikes and comments from YouTube videos?)

1. We want to find whether there is any relationship bebtween number of views, likes, dislikes and comments from YouTube videos?
2. We want to know recent trend of YouTube viewers and their activity through data of views, likes, dislikes and comments
3. The data has time frame starting from Nov 2017 ending in June 2018.

Import data

file_location <- file.choose()

us_youtube_trend <- read.csv(file_location) %>%
                        mutate(country = "US")

file_location <- file.choose()

ca_youtube_trend <- read.csv(file_location) %>%
                        mutate(country = "CA")

youtube_trend <- rbind(us_youtube_trend, ca_youtube_trend)

Getting data from “USvideos.csv” and “CAvideos.csv” which is given by Mitchell J in Kaggle. The kaggle link is following: https://www.kaggle.com/datasnaek/youtube-new\. The data was originally collected for data sharing in Kaggle webpage about 2 years ago. Each case represent one trending YouTube video. For example, there is a row about YouTube video posted by Eminem. It was treding on Nov 14, 2017 and had views of 17158579, likes of 787425, dislikes of 43420, and comments of 125882. In our dataset, there are 40926 rows of trending YouTube videos. I plan to use variables “trending_date”, “views”, “likes”, “dislikes”, “comment_count”, and “comment_disabled”. The region is US AND Canada.

Inspect data

The six example rows are shown below

head(youtube_trend)

These are the column names of “youtube_trend” data frame

names(youtube_trend)

 [1] "video_id"               "trending_date"         
 [3] "title"                  "channel_title"         
 [5] "category_id"            "publish_time"          
 [7] "tags"                   "views"                 
 [9] "likes"                  "dislikes"              
[11] "comment_count"          "thumbnail_link"        
[13] "comments_disabled"      "ratings_disabled"      
[15] "video_error_or_removed" "description"           
[17] "country"               

Clean data

youtube_trend <- youtube_trend %>%
                    filter(video_error_or_removed == "False") %>%
                    mutate(trending_date = ydm(trending_date))

Remove videos that were removed or was confirmed to be an error. These videos are classified as “True” for column “video_error_or_removed”

Relationship between number of views, likes, dislikes, and comments in a single video

ggplot(youtube_trend, aes(x = views, y = likes, color = country)) + geom_point() + geom_smooth(method = "loess", se = FALSE)

We can see from the scatterplot that there seems to be a logarithmic relationship between number of views and number of likes in a YouTube video.

ggplot(youtube_trend, aes(x = views, y = dislikes, color = country)) + geom_point() + geom_smooth(method = "loess", se = FALSE)

We can see from the scatterplot that there seems to be a linear relationship between number of views and number of dislikes in YouTube videos. This means that it is evitable that there should be increase in dislikes when number of views increase. We can aslo see some videos have higer rate of increasing dislikes for certain amount of views.

ggplot(youtube_trend, aes(x = views, y = comment_count, color = country)) + geom_point() + geom_smooth(method = "loess", se = FALSE)

We can see from the scatterplot that there seems to be a logarithmic (but very close to linear) relationship between number of views and number of comments in YouTube videos.

ggplot(youtube_trend, aes(x = likes, y = dislikes, color = country)) + geom_point() + geom_smooth(method = "loess", se = FALSE)

We can see from the scatterplot that there seems to be a very straight linear relationship between number of likes and number of dislikes in YouTube videos.

ggplot(youtube_trend, aes(x = likes, y = comment_count, color = country)) + geom_point() + geom_smooth(method = "loess", se = FALSE)

We can see from the scatterplot that there seems to be a very straight linear relationship between number of likes and number of cimments in YouTube videos.

ggplot(youtube_trend, aes(x = dislikes, y = comment_count, color = country)) + geom_point() + geom_smooth(method = "loess", se = FALSE)

We can see from the scatterplot that there seems to be a logarithmic relationship between number of dislikes and number of comment in YouTube videos.

Is there any relationship between disabling comment and number of dislikes a YouTube video received?

com_dis <- youtube_trend %>%
              filter(comments_disabled == "True")

mean(com_dis$dislikes)

[1] 1960.685

mean(com_dis$likes)

[1] 17946.33

com_non_dis <- youtube_trend %>%
                  filter(comments_disabled == "False")

mean(com_non_dis$dislikes)

[1] 2875.127

mean(com_non_dis$likes)

[1] 57532.42

The YouTube videos with comment disabled have average number of 1960.685 dislikes and average number of 17946.33 likes. YouTube videos with comment not disabled has average number of 2875.127 dislikes and average number of 57532.42 likes. We can see that videos that have comment disabled got much less likes and dislikes than vidoes that have comment enabled.

For YouTube videos with more dislikes than likes, do these videos have higer probability of disabling comments than videos that have more likes than dislikes?

more_dislike <- youtube_trend %>%
                  filter(dislikes > likes)
more_like <- youtube_trend %>%
                filter(likes > dislikes) %>%
                sample_n(841)

As there are only 841 videos that have more dislikes than likes, we will also sample only 841 videos from list of videos that have more likes than dislikes.

com_dis_df <- data.frame(Date=as.Date(character()),
                 File=character(), 
                 User=character(), 
                 stringsAsFactors=FALSE) 

nrow(more_dislike)

[1] 841

com_dis_dis <- sum(more_dislike$comments_disabled == "True")
com_dis_dis

[1] 53

nrow(more_like)

[1] 841

com_dis_non <- sum(more_like$comments_disabled == "True")
com_dis_non

[1] 12

From 841 YouTube videos that have more dislikes than likes, there are 53 videos that have their comments disabled. From 841 YouTube videos that have more likes than dislikes, there are 12 videos that have their comments disabled. (**The number of videos that have more likes than dislikes while comments are disabled might vary as the sample might change from sampling)

com_dis_df <- rbind(com_dis_df, c("more like", com_dis_non/nrow(more_like)), c("more dislike", com_dis_dis/nrow(more_dislike))) 

colnames(com_dis_df) <- c("category", "proportion")

com_dis_df

ggplot(com_dis_df, aes(x = category, y = proportion)) + geom_bar(stat = "identity", fill = "steelblue") + theme_minimal()

We can see from this plot that YouTube vidoes that have more dislikes than likes have 4.4 times (This number might differ by change in sample data) more probability that the video will disable comments.

Decision Tree

Get libaries needed for making decision tree

library(multcomp)
library(party)

Make another column that distinguishes whether the row has more dislikes than likes

dislike_decision <- youtube_trend %>%
                        mutate(dislike_more = ifelse(dislikes > likes, "yes", "no"))

Decision tree on how views, likes, comment count, and dislikes allows you to know whether the YouTube video has more dislikes than likes

tree <- dislike_decision %>%
    ctree(dislike_more == "yes" ~ views + likes + comment_count + dislikes, data = ., controls = ctree_control(maxdepth = 3))

plot(tree, type = "simple")

There are some interesting output here.
If a YouTube video has more than 3773 dislikes and have views less than 467531, than it has probability of 61.9% that the video will have more dislikes than likes.
This means we can predict with the accuracy of about 62% whether a video has more dislikes than likes just by using number of dislikes and number of views.

Decision tree on how views and comment count allows you to know whether the YouTube video has more dislikes than likes

tree2 <- dislike_decision %>%
    ctree(dislike_more == "yes" ~ views + comment_count, data = ., controls = ctree_control(maxdepth = 3))

plot(tree2, type = "simple")

We can see from this decision tree that it is difficult to predict or categorize a video whether it has more dislikes than likes with just number of views and comment_count

Most popular YouTube channel

US Channels

us_channel_pop <- us_youtube_trend %>%
                    group_by(channel_title) %>%
                    summarise(count = n()) %>%
                    filter(count > 160)

In order to make our plot more readable, we will constraint the number of videos that were trending to be greater than 160.

ggplot(us_channel_pop, aes(x = reorder(channel_title, count), y = count)) + geom_bar(stat = "identity", fill = "steelblue") + theme_minimal() + coord_flip()

We can see from this plot that the most popular YouTube channel from Nov 2017 to June 2018 was ESPN. Also, show from Jimmy Fallon, Vox, Ellen show, Netflix were also very popular.

Canada Channels

ca_channel_pop <- ca_youtube_trend %>%
                    group_by(channel_title) %>%
                    summarise(count = n()) %>%
                    filter(count > 160)

In order to make our plot more readable, we will constraint the number of videos that were trending to be greater than 160.

ggplot(ca_channel_pop, aes(x = reorder(channel_title, count), y = count)) + geom_bar(stat = "identity", fill = "steelblue") + theme_minimal() + coord_flip()

We can see from this plot that the most popular YouTube channel from Nov 2017 to June 2018 was SET India. Also, videos from MSNBC, FBE, “The Young Turks” were also very popular.

YouTube channels with a single video having most views

US Channels

us_channel_max <- us_youtube_trend %>%
                    group_by(channel_title) %>%
                    summarise(max = max(views)) %>%
                    filter(max > 10**8)

ggplot(us_channel_max, aes(x = reorder(channel_title, max), y = max)) + geom_bar(stat = "identity", fill = "steelblue") + theme_minimal() + coord_flip()

The video from channel “ChildishGambinoVEVO” had the most views out of a single video with staggering two hundred million views.

Canada Channels

ca_channel_max <- ca_youtube_trend %>%
                    group_by(channel_title) %>%
                    summarise(max = max(views)) %>%
                    filter(max > 5*10**7)

ggplot(ca_channel_max, aes(x = reorder(channel_title, max), y = max)) + geom_bar(stat = "identity", fill = "steelblue") + theme_minimal() + coord_flip()

The video from channel “YouTube Spotlight” had the most views out of a single video with staggering one hundred million views.

Total views by trending date

total_views_by_date <- youtube_trend %>%
                          group_by(trending_date) %>%
                          summarise(total_views = sum(views))

ggplot(total_views_by_date, aes(x = trending_date, y = total_views)) + geom_line(aes(x = trending_date, y = total_views, group = 1)) + theme_minimal()

We can see from this plot that the total number of views from trending videos have increases quite a bit since April.

Total likes and dislikes by trending date (YouTube sentiment)

likes_dislikes <- youtube_trend %>%
                    group_by(trending_date) %>%
                    summarise(total_likes = sum(likes), total_dislikes = sum(dislikes), total_comments = sum(comment_count))

likes_dislikes <- likes_dislikes %>%
                    pivot_longer(cols = c(total_likes, total_dislikes, total_comments), names_to = "sentiment", values_to = "count")

ggplot(likes_dislikes, aes(x = trending_date, y = count, group = sentiment, colour = sentiment)) + geom_line(size = 1) + theme_minimal()

Total number of likes have also increase dramatically since April. It was interesting that the increase of dislikes have not been increased as much as likes. We could see that trending videos have generated tons of likes while not much change in dislikes.

proportional_likes <- youtube_trend %>%
                        group_by(trending_date) %>%
                        summarise(total_likes = sum(likes), total_dislikes = sum(dislikes), total_comments = sum(comment_count))

ggplot(proportional_likes, aes(x = trending_date, y = total_likes/total_dislikes)) + geom_line(size = 1) + theme_minimal()

However if we see this plot ,which plots the proportion of likes and dislikes for each day, we can see that there hasn’t been a lot of change of proportion during the dates when data was recorded.

Top 10 Video Categories - Based on Views

We have collected actual category names for each category from YouTube webpage.

categories_id <- as.character(c(1, 2, 10, 15, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44))
categories <- c("Film & Animation", "Autos & Vehicles", "Music", "Pets & Animals", "Sports", "Short Movies", "Travel & Events", "Gaming", "Videoblogging", "People & Blogs", "Comedy", "Entertainment", "News & Politics", "How-to & Style", "Education", "Science & Technology", "Nonprofits & Activism", "Movies", "Anime/Animation", "Action/Adventure", "Classics", "Comedy", "Documentary", "Drama", "Family", "Foreign", "Horror", "Sci-Fi/Fantasy", "Thriller", "Shorts", "Shows", "Trailers")

Make data frame “category_id_list” by combining two vectors

category_id_list <- data.frame(cbind(categories_id, categories), stringsAsFactors=FALSE)

colnames(category_id_list) <- c("category_id", "categories")

Join data frame “category_id_list” with data frame “us_youtube_trend”

us_youtube_trend <- us_youtube_trend %>%
                      mutate(category_id = as.numeric(category_id))

category_id_list <- category_id_list %>%
                      mutate(category_id = as.numeric(category_id))

us_youtube_trend <- us_youtube_trend %>%
                      left_join(category_id_list)

Joining, by = "category_id"

Join data frame “category_id_list” with data frame “ca_youtube_trend”

ca_youtube_trend <- ca_youtube_trend %>%
                      mutate(category_id = as.numeric(category_id))

category_id_list <- category_id_list %>%
                      mutate(category_id = as.numeric(category_id))

ca_youtube_trend <- ca_youtube_trend %>%
                      left_join(category_id_list)

Joining, by = "category_id"

US Channels

us_channel_categ <- 
  aggregate(views~categories, data = us_youtube_trend, sum)%>%
  arrange(desc(views)) %>%
  head(10)

ggplot(us_channel_categ, aes(x = reorder(categories, views), y = views)) + geom_bar(stat = "identity", fill = "steelblue") + theme_minimal() + coord_flip()

This shows that category “Music” is, by far, the most popular video category on YouTube in the US. The “Entertainment” and “Film & Animation” follows the lead behind “Music”.

Canada Channels

ca_channel_categ <- 
  aggregate(views~categories, data = ca_youtube_trend, sum)%>%
  arrange(desc(views)) %>%
  head(10)

ggplot(ca_channel_categ, aes(x = reorder(categories, views), y = views)) + geom_bar(stat = "identity", fill = "steelblue") + theme_minimal() + coord_flip()

This shows that category “Entertainment” is, by far, the most popular video category on Yotube in Canada. The “Music” and “Comedy” follows the lead behind “Entertainment”.

Top 5 Channels with highest reaction/response, based on the overall comments per view

US Channels

us_reaction <- 
  mutate(us_youtube_trend, reaction = ((comment_count/views)*1000))

us_reaction_categ <-
  us_reaction %>%
  group_by(categories) %>%
  summarise(count= n(),total_reaction = sum(reaction)) %>%
  mutate(average_reaction= (count/total_reaction)) %>%
  arrange(average_reaction)

ggplot(us_reaction_categ, aes(x = reorder(categories, average_reaction), y = average_reaction)) + geom_bar(stat = "identity", fill = "steelblue") + theme_minimal() + coord_flip()

We have calculated the average reaction parameter for each categories of YouTube vidoe

CA Channels

ca_reaction <- 
  mutate(ca_youtube_trend, reaction = ((comment_count/views)*1000))

ca_reaction_categ <-
  ca_reaction %>%
  group_by(categories) %>%
  summarise(count= n(),total_reaction = sum(reaction)) %>%
  mutate(average_reaction= (count/total_reaction)) %>%
  arrange(average_reaction)

ggplot(ca_reaction_categ, aes(x = reorder(categories, average_reaction), y = average_reaction)) + geom_bar(stat = "identity", fill = "steelblue") + theme_minimal() + coord_flip()